home *** CD-ROM | disk | FTP | other *** search
/ QRZ! Ham Radio 8 / QRZ Ham Radio Callsign Database - Volume 8.iso / pc / files / mac / proj_a1.hqx / Project Mac - A1 / Ham Grid Dist & Direction (.txt) < prev    next >
AmigaBASIC Source Code  |  1987-12-04  |  4KB  |  152 lines
  1. '  ********************************************************
  2. '  *  This program is from "The ARRL World Grid Locator Atlas"                *
  3. '  *  Copyright 1984 Folke Rosval, SM5AGM.  This atlas is Available         *
  4. '  *  from ARRL HQ for $4.00 . This program entered and modified for the *             *
  5. '  *  Macintosh by  Jim Bradbury, WB5ACL / DA2ND, December 1987         *
  6. '  ********************************************************
  7.     PRINT "This Program computes Direction and Distance between"
  8.     PRINT "two Grid Locations."
  9.     PRINT 
  10. 100 X0=6378.14
  11.        X1=6356.75
  12.        X2=0.014
  13.        X3=1.8
  14.        X4=4
  15.        X5=2*ATN(1)
  16.        X6=2*X5
  17.        X7=2*X6
  18. 110 X8=X5/90
  19.        A = X0*X0
  20.        B = X1 * X1
  21.        B = 1 + (A-B)/B
  22.        C = SQR(B)
  23.        A = A/X1
  24.        X9 = (1+1/C/B)*A/2
  25. 120 Y0=A-X9
  26.         Y1=(X0+A)/2
  27.         Y2=A-Y1
  28.         Y3=(2*X9/X0-1)*X6
  29.         Y4=X0-X9
  30.         Y5=X7*(1-X9/X0)
  31.  130 YD5=Y5*Y5
  32.  140 PRINT "Grid Locations can be:"
  33.         PRINT  "Two Letters                                               ->           ";
  34.         <0x10c262d,0x07>(12):<0x1a,0x00>(0):<0x1a,0x01>(0):PRINT"JN"
  35.         <0x10c2672,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
  36.         PRINT  "Two Letters and Two Numbers                   ->           ";
  37.         <0x10c26fb,0x07>(12):<0x1d,0x00>(0):<0x1d,0x01>(0):PRINT "JN49"
  38.         <0x10c2743,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
  39.         PRINT  "or, Two Letters, Two Numbers, and Two Letters ->  ";
  40.         <0x10c27c3,0x07>(12):<0x1f,0x00>(0):<0x1f,0x01>(0):PRINT "JN49GL"
  41.         <0x10c280d,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
  42.         PRINT
  43.      INPUT"Enter FROM Grid Location " ;A$
  44.          LOC1$=A$
  45.          GOSUB 290
  46.          IF E = 1 THEN E = 0: GOTO 140
  47.   150 A = C * X8
  48.           B = D * X8
  49.   160 INPUT "Enter TO Grid Location ";A$
  50.            LOC2$=A$
  51.          GOSUB 290
  52.          IF E = 1 THEN E = 0: GOTO 160
  53.   170 C=C*X8
  54.          D=D*X8
  55.          E=C-A
  56.          F=SIN(B)
  57.          G=SIN(D)
  58.          H=COS(B)
  59.          I=COS(D)
  60.          J=COS(E)
  61.   180 K = F*G+H*I*J
  62.           GOSUB 370
  63.           M = L
  64.           IF ABS(K) < 1 THEN N = (G*H-I*F*J)/SQR(1-K*K)
  65.    190 K = N
  66.            GOSUB 370
  67.            G = L
  68.            I = M/X4
  69.            J = -I/3
  70.            P = 0
  71.            FOR Q = 1 TO 4
  72.                J = J + I
  73.                K = COS(J)*F+SIN(J)*H*N
  74.                GOSUB 370
  75.                R = 0
  76.                IF L <> 0 THEN R = H*SIN(G)/SIN(L)
  77.                S = R * X5
  78.                IF ABS(R) < 1 THEN S = ATN(R/SQR(1-R*R))
  79.                R = COS(2*L)
  80.                T = X9 + Y0*R
  81.                R = Y1 + Y2*R
  82.                P = P + (T+R)/2 + (T-R)/2*COS(2*S)
  83.            NEXT
  84.            F = P / X4
  85.            H = 0
  86.            I = M-Y3
  87.            IF I > 0 THEN H = I*I*(F-X9)/Y5
  88.     240 I = SIN(X6*(X0-F)/Y4)
  89.            J = Y3*(1-X2*I)
  90.            IF M > J THEN H = H +X3*I*SIN(X6*SQR((X6-M)/(X6-J)))
  91.            F = (F-H)*M
  92.            IF F < 0.5 OR F > 20003.5 THEN G = 0: GOTO 280
  93.     270 IF E * (X6-ABS(E)) < 0 THEN G = X7-G
  94.  
  95.  280 PRINT 
  96.         PRINT "From Grid location ";
  97.         <0x10c2dfe,0x07>(12):<0x1b,0x00>(0):<0x1b,0x01>(0):PRINT LOC1$
  98.         <0x10c2e45,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
  99.         PRINT "            to location ";
  100.         <0x10c2eaa,0x07>(12):<0x1b,0x00>(0):<0x1b,0x01>(0):PRINT LOC2$
  101.         <0x10c2ef1,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
  102.         PRINT " The Direction is ";
  103.         <0x10c2f50,0x07>(12):<0x2d,0x00>(0):<0x2d,0x01>(0):PRINT INT(G/X8+0.5);"í,";
  104.         <0x10c2fa5,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
  105.         PRINT " and the Distance is ";
  106.         <0x10c3007,0x07>(12):<0x24,0x00>(0):<0x24,0x01>(0):PRINT INT(F+0.5);
  107.         PRINT "Kilometers."
  108.         <0x10c3070,0x07>(12):<0x1d,0x00>(0):<0x1d,0x01>(9):PRINT:GOTO 160
  109.  
  110.    290 F = LEN(A$)
  111.            IF F <> 2 AND F <> 4 AND F <> 6 THEN E = 1: RETURN
  112.            
  113.    300 FOR G = 1 TO F
  114.                A(G) = ASC(MID$(A$,G,1))
  115.           NEXT
  116. ' IF Lower Case, Change to Upper Case
  117.           FOR G = 1 TO F
  118.                IF A(G) > 82 THEN A(G) = A(G) - 32
  119.           NEXT
  120.  
  121.    310 IF A(1) < 65 OR A(1) > 82 OR A(2) < 65 OR A(2) > 82 THEN E = 1: RETURN
  122.           
  123.    320 C = A(1) *20-1480
  124.            D = A(2) * 10 - 740
  125.            IF F = 2 THEN C = C+ 10 : D = D + 5: RETURN
  126.  
  127.    330 IF A(3) < 48 OR  A(3) > 57 OR  A(4) < 48 OR  A(4) > 57 THEN E = 1:RETURN
  128.    
  129.    340 C = C + A(3)*2-96
  130.            D = D + A(4)-48
  131.            IF F = 4 THEN C = C + 1: D = D + 0.5: RETURN
  132.  
  133.    350 IF A(5) < 65 OR  A(5) > 88 OR  A(6) < 65 OR  A(6) > 88 THEN E = 1: RETURN
  134.    
  135.    360 C = C+(A(5)-64.5) / 12
  136.            D = D + (A(6)-64.5)/24
  137.            RETURN
  138.            
  139.    370 IF K > 1 THEN K = 1: L = 0: RETURN
  140.    
  141.    380 IF K <= -1 THEN K = -1: L = X6: RETURN
  142.  
  143.    390 L = X5-ATN(K/SQR(1-K*K)): RETURN
  144.    
  145.            
  146.           
  147.           
  148.           
  149.  
  150.        
  151.       
  152.